Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/s_to_z/tpack/toolbar.pas

Pascal/Delphi Source File | 1996-09-15 | 6.2 KB | 265 lines

unit Toolbar;
{defines a bunch of customized panels, holds a toolbutton and edit-rightaligned type also.}

interface

uses Forms, SysUtils, WinProcs, WinTypes,
  Classes, Controls, Buttons, StdCtrls, ExtCtrls;

type
  TExtendedPanel = class(TPanel)
  private
    procedure SetUniqueName(const Value:String);
  public
    constructor Create(aOwner:TComponent); Override;
    property UniqueName:String write SetUniqueName stored false;
  published
    end;

  TToolBar = class(TExtendedPanel)
  public
    constructor Create(aOwner:TComponent); Override;
    end;

  TStatusBar = class(TExtendedPanel)
  public
    constructor Create(aOwner:TComponent); Override;
    end;

  TStatusPanel = class(TExtendedPanel)
  private
    procedure ShowHint(Sender: TObject);
  public
    constructor Create(aOwner:TComponent); Override;
    procedure Loaded; Override;
    end;

  TMpModes=(mpIdle,mpTime,mdDate,mpResources);
  TMessagePanel = class(TExtendedPanel)
  protected
    fmpMode: TmpModes;
    fTimer: TTimer;
    fPriorIdle: TIdleEvent;
  private
    procedure IdleEvent(Sender: TObject; var Done: Boolean);
    procedure UpdatePanel(Sender: TObject);
    procedure SetMpMode(Value:TmpModes);
  public
    constructor Create(aOwner:TComponent); Override;
    destructor Destroy; Override;
    procedure Click; Override;
  published
    property mpMode: TmpModes read fmpMode write SetMpMode;
    end;

{------------------------------------------------------------------------------}

  TToolButton = class(TSpeedButton)
  private
    fLeaveSpace: Boolean;
  public
    constructor Create(aOwner:TComponent); Override;
    procedure Loaded; Override;
  published
    property LeaveSpace: Boolean read fLeaveSpace write fLeaveSpace;
    end;

  TEdRight = class(TEdit)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure CreateParams(var Params: TCreateParams); Override;
  published
    { Published declarations }
  end;

{------------------------------------------------------------------------------}

implementation

{------------------------------------------------------------------------------}

constructor TToolButton.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  Top:=2;
  if csDesigning in ComponentState then
    SetBounds(0, 0, 20, 20);
end;

procedure TToolbutton.Loaded;
begin
  inherited Loaded;
end;

{------------------------------------------------------------------------------}

constructor TExtendedPanel.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
end;

procedure TExtendedPanel.SetUniqueName(const Value:String);
var
  i:integer;
  a:string[4];
begin
  a:='1';
  i:=1;
  while true do
    if owner.findcomponent(Value+a)=nil then begin
      name:= Value+a;
      break;
      end
    else begin
      inc(i);
      a:=inttostr(i);
      end;
end;

{------------------------------------------------------------------------------}

constructor TToolBar.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  if aOwner.Name<>'' then begin
    Align:=alTop;
    Height:=23;
    UniqueName:='ToolBar';
    Caption:='';
    end;
end;

{------------------------------------------------------------------------------}

constructor TStatusBar.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  if aOwner.Name<>'' then begin
    Top:=TForm(aOwner).Height-1;
    Align:=alBottom;
    Height:=18;
    UniqueName:='StatusBar';
    Caption:='';
    with TMessagePanel.Create(aOwner) do
      Parent:=Self;
    with TStatusPanel.Create(aOwner) do
      Parent:=Self;
    end;
end;

{------------------------------------------------------------------------------}

constructor TStatusPanel.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);
  if aOwner.Name<>'' then begin
    Align:=alClient;
    UniqueName:='StatusPanel';
    Caption:='';
    Alignment := taLeftJustify;
    BevelOuter := bvLowered;
    end;
  Loaded;
end;

procedure TStatusPanel.Loaded;
begin
  inherited Loaded;
  Application.OnHint:=ShowHint;      {WATCH IT!!! THIS is a pretty big assumption}
  Application.ShowHint:=True;
  Application.HintPause:=300;
end;

procedure TStatusPanel.ShowHint(Sender: TObject);
begin
  Caption := Application.Hint;
end;

{------------------------------------------------------------------------------}

constructor TMessagePanel.Create(aOwner:TComponent);
begin
  inherited Create(aOwner);

  if aOwner.Name<>'' then begin
    Align:=alRight;
    Width:=85;
    UniqueName:='MessagePanel';
    Caption:='';
    {}
    BevelOuter := bvLowered;
    Alignment := taCenter{LeftJustify};
    {}
    fPriorIdle:= Application.OnIdle;
    Application.OnIdle:=IdleEvent;
    end;

  fmpMode:=mpTime;
  fTimer:=TTimer.Create(self);
  fTimer.Interval:=1000;
  fTimer.Enabled:=True;
  fTimer.OnTimer:=UpdatePanel;
end;


destructor TMessagePanel.Destroy;
begin
  fTimer.enabled:=false;
  fTimer.free;
  Application.OnIdle:=fPriorIdle;
  inherited Destroy;
end;

procedure TMessagePanel.SetMpMode(Value:TMpModes);
begin
  if Value<>fmpMode then begin
    fmpMode:=Value;
    fTimer.Enabled:=Value<>mpIdle;
    end;
end;

procedure TMessagePanel.Click;
begin
  if fmpmode<high(tmpmodes) then
    mpMode:=succ(fMpMode)
  else
    mpmode:=low(tmpmodes);
  inherited Click;
end;

procedure TMessagePanel.IdleEvent(Sender: TObject; var Done: Boolean);
begin
  if assigned(fPriorIdle) then
    fPriorIdle(Sender,Done);
  UpdatePanel(Sender);
end;

procedure TMessagePanel.UpdatePanel(Sender: TObject);
begin
  case fmpMode of
    mpIdle,
    mpTime: Caption := TimeToStr(Time);
    mdDate: Caption := DateToStr(Now);
  else
    Caption:= format('%d MB, %d%%',
     [GetFreeSpace(0) shr 20, GetFreeSystemResources(0)]);
    end;
end;

{------------------------------------------------------------------------------}

procedure TEdRight.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or ES_RIGHT;
end;

{------------------------------------------------------------------------------}

end.